home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / s / unitsconverter.pprx < prev    next >
Text File  |  1993-02-19  |  7KB  |  370 lines
  1. /*
  2. @BUnitsConverter  @P@ICopyright Gold Disk Inc., February, 1992
  3.  
  4. UnitsConverter allows you to enter values in inches, points, picas, cm, ciceros, or agates, and convert to all other units.
  5. */
  6. numeric digits 8
  7. cr = '0a'x 
  8. dnumbers = " 1234567890."
  9. numbers = " 1234567890"
  10. signal on syntax
  11.  
  12. /* Check if math library is runnning. If not, try to load it   */
  13. if ~show('l', 'gdarexxsupport.library') then
  14. do
  15.    if ~addlib('gdarexxsupport.library',0,-30,0) then
  16.       call exit_msg('Please Install gdarexxsupport.library in LIBS: directory')
  17. end
  18.  
  19. /* start with decimal fraction of 1 inch  */
  20. dinches  = 1
  21. points   = ""
  22. inches   = ""
  23. pica  = ""
  24. cicero   = ""
  25. cent  = ""
  26. agates    = ""
  27.  
  28. do forever
  29.  
  30.       if inches ~= '' then
  31.       do
  32.  
  33.          if verify(inches, " 1234567890./") ~= 0 then
  34.             call exit_msg('Invalid Entry')
  35.  
  36.          dinch = ftod(inches)
  37.  
  38.       end
  39.       else if dinches ~= '' then
  40.       do
  41.  
  42.          if verify(dinches, dnumbers) ~= 0 then
  43.             call exit_msg('Invalid Entry')
  44.  
  45.          dinch = dinches
  46.  
  47.       end
  48.       else if pica ~= '' then
  49.       do
  50.  
  51.          if verify(pica, " 1234567890.Pp") ~= 0 then
  52.             call exit_msg('Invalid Entry')
  53.  
  54.          dinch = ptoint(pica)
  55.  
  56.       end
  57.       else if points ~= '' then
  58.       do
  59.  
  60.          if verify(points, " 1234567890.") ~= 0 then
  61.             call exit_msg('Invalid Entry')
  62.  
  63.          dinch = points / 72
  64.  
  65.       end
  66.       else if cent ~= '' then
  67.       do
  68.          if verify(cent, dnumbers) ~= 0 then
  69.             call exit_msg('Invalid Entry')
  70.  
  71.          dinch = cent / 2.54
  72.  
  73.       end
  74.       else if agates ~= '' then
  75.       do
  76.          if ~datatype(agates, n) then
  77.             call exit_msg('Invalid Entry')
  78.  
  79.         dinch = agates / 14
  80.  
  81.       end
  82.       else if cicero ~= '' then
  83.       do
  84.          if verify(cicero, " 1234567890Cc.") ~= 0 then
  85.             call exit_msg('Invalid Entry')
  86.  
  87.          dinch = ctoint(cicero)
  88.  
  89.       end
  90.       else
  91.          exit
  92.  
  93.    if inches   = '' then inches  = dtof(dinch)
  94.    if dinches  = '' then dinches = dinch
  95.    if cent     = '' then cent    = dinch * 2.54
  96.    if pica     = '' then pica    = itop(dinch)
  97.    if points   = '' then points  = dinch * 72
  98.    if cicero   = '' then cicero  = itoc(dinch)
  99.    if agates   = '' then agates  = (dinch * 14) % 1
  100.  
  101.    form = "Fractional Inches:"inches || cr"Decimal Inches:"dinches || cr"Picas:"pica || cr"Points:"points || cr"Centimetres:"cent || cr"Ciceros:"cicero||cr"Agates:"agates
  102.  
  103.    entry = ppm_GetForm("Conversion yields..", 18, form)
  104.    if entry = '' then exit
  105.    parse var entry ninches '0a'x ndinches '0a'x npicas '0a'x npoints '0a'x ncent '0a'x nciceros '0a'x nagates
  106.  
  107.    if compare(ninches, inches) ~= 0 then
  108.    do
  109.       inches   = ninches
  110.       pica  = ''
  111.       cent  = ''
  112.       points   = ''
  113.       dinches  = ''
  114.       cicero   = ''
  115.       agates   = ''
  116.    end
  117.    else if compare(dinches, ndinches ) ~= 0 then
  118.    do
  119.       dinches  = ndinches
  120.       pica  = ''
  121.       cent  = ''
  122.       points   = ''
  123.       inches   = ''
  124.       agates   = ''
  125.       cicero   = ''
  126.    end
  127.    else if compare(pica, npicas ) ~= 0 then
  128.    do
  129.       pica  = npicas
  130.       cent  = ''
  131.       points   = ''
  132.       inches   = ''
  133.       dinches  = ''
  134.       cicero   = ''
  135.       agates   = ''
  136.  
  137.    end
  138.    else if compare(points, npoints ) ~= 0 then
  139.    do
  140.       cent  = ''
  141.       points   = npoints
  142.       pica  = ''
  143.       inches   = ''
  144.       dinches  = ''
  145.       agates   = ''
  146.       cicero   = ''
  147.    end
  148.    else if compare(cent, ncent ) ~= 0 then
  149.    do
  150.       dinches  = ''
  151.       pica  = ''
  152.       cent  = ncent
  153.       points   = ''
  154.       inches   = ''
  155.       agates   = ''
  156.       cicero   = ''
  157.    end
  158.    else if compare(cicero, nciceros) ~= 0 then
  159.    do
  160.       dinches  = ''
  161.       pica  = ''
  162.       cent  = ''
  163.       points   = ''
  164.       agates   = ''
  165.       inches   = ''
  166.       cicero   = nciceros
  167.    end
  168.    else if compare(agates, nagates) ~= 0 then
  169.    do
  170.       dinches  = ''
  171.       pica  = ''
  172.       cent  = ''
  173.       points   = ''
  174.       inches   = ''
  175.       cicero   = ''
  176.       agates   = nagates % 1
  177.    end
  178.    else exit
  179.  
  180. end
  181.  
  182. exit
  183.  
  184. exit_msg:
  185. do
  186.    parse arg message
  187.  
  188.    call ppm_Inform(1, message, )
  189.    exit
  190. end
  191.  
  192. itop: procedure
  193. do
  194.    arg iinches
  195.  
  196.    picas    = ppm_ConvertUnits(1, 3, iinches) 
  197.    intpart  = picas % 1
  198.    decpart    = substr(picas, lastpos('.', picas) + 1)
  199.  
  200.    return(intpart"p"decpart)
  201.  
  202. end
  203.  
  204. itoc: procedure
  205. do
  206.    arg iinches
  207.  
  208.    cpoints  = iinches * 66.9566
  209.    cic      = cpoints % 12
  210.    cpoints = cpoints - cic * 12 
  211.  
  212.    if cic < 1 then return("c"cpoints)
  213.    else return(cic"c"cpoints)
  214.  
  215. end
  216.  
  217.  
  218. ptoint: procedure
  219. do
  220.     arg entry
  221.     entry = upper(entry)
  222.     p = pos('P',entry)
  223.  
  224.     if p = 0 then
  225.     do
  226.         if datatype(entry) ~= 'NUM' then exit_msg("Invalid entry")
  227.         return(entry / 6 )
  228.     end
  229.     else
  230.     do
  231.         points  = substr(entry, p + 1)
  232.         picas   = left(entry, p - 1)
  233.  
  234.         if picas = '' then picas = 0 
  235.         else if ~datatype(picas,n) then exit_msg("Invalid entry")
  236.         else picas = picas / 6
  237.  
  238.         if points = '' then points = 0 
  239.         else if datatype(points) ~= 'NUM' then exit_msg("Invalid entry")
  240.         else points = points / 72
  241.         return( picas + points )
  242.  
  243.     end
  244.  
  245. end
  246.  
  247. ctoint: procedure
  248. do
  249.    arg cic
  250.  
  251.    c = pos('C',cic)
  252.    if c = 0 then c = pos('c', cic)
  253.  
  254.    decimal = pos('.', cic )
  255.  
  256.    if c = 0 then
  257.    do
  258.       return(cic * .1792 )
  259.    end
  260.    else
  261.    do
  262.       pcics = substr(cic, (c+1))
  263.       cic      = strip(left(cic, c - 1))
  264.  
  265.       if cic = '' then cic = 0 
  266.       if pcics = '' then pcics = 0
  267.       else if pcics >= 12 then
  268.       do
  269.          cic      = cic + pcics % 12
  270.          pcics = pcics // 12
  271.       end
  272.  
  273.       iinches = cic * .1792 + pcics * .0149
  274.       return( iinches )
  275.  
  276.    end
  277.  
  278. end
  279.  
  280. ftod: procedure expose dnumbers numbers
  281. do
  282.    
  283.    arg fraction
  284.    
  285.    decimal = 0
  286.  
  287.    wrdcnt = words( fraction )
  288.  
  289.    if wrdcnt > 2 then 
  290.       call exit_msg('Invalid Fraction entered')
  291.    else if wrdcnt = 2 then
  292.    do
  293.       decimal = word(fraction, 1)
  294.  
  295.       if verify(decimal, dnumbers) ~= 0 then
  296.          call exit_msg('Invalid Fraction entered')
  297.  
  298.       fraction = word(fraction, 2)
  299.  
  300.    end
  301.  
  302.    slash = pos('/', fraction )
  303.    if slash = 0 then
  304.     do
  305.         if datatype(fraction) ~= 'NUM' then exit_msg("Invalid entry")
  306.         else return(fraction)
  307.     end
  308.    if left(fraction, slash - 1 ) = 0 then signal syntax
  309.  
  310.    if slash = 0 then
  311.       call exit_msg('Invalid Fraction entered')
  312.  
  313.    interpret "decimal = decimal + "fraction
  314.  
  315.    return( decimal )
  316.  
  317. end
  318.  
  319. dtof: procedure
  320. do
  321.    arg decimal
  322.    xnumbers = "1234567890"
  323.  
  324.    /* Convert a decimal number to a fraction with the precision
  325.     * of 1/72
  326.     */
  327.     MAX = 72
  328.     tol = 1/MAX
  329.  
  330.    point = pos('.', decimal )
  331.  
  332.    if point = 0 then return( decimal )
  333.  
  334.    integral = left(decimal, point - 1)
  335.  
  336.  
  337.    decimal     = substr(decimal, point + 1 )
  338.  
  339.    if verify(decimal, xnumbers ) ~= 0 then
  340.       exit_msg('Invalid Fraction entered')
  341.  
  342.    curval = "."decimal
  343.    if curval < tol then return(integral)
  344.  
  345.    do gcd = 1 to ( MAX - 1 )
  346.  
  347.       n = gcd * curval
  348.       if abs(n - nint(n)) < tol then leave
  349.  
  350.    end
  351.  
  352.    numerator = max(nint(gcd * curval) % 1, 1 )
  353.  
  354.    if gcd = 1 then
  355.    do
  356.       if integral = '' then integral = 0
  357.       return( integral + numerator )
  358.    end
  359.  
  360.    return( integral" "numerator"/"gcd )
  361.  
  362. end
  363.  
  364.  
  365.  
  366. syntax:
  367. do
  368.    exit_msg("Genie failed due to error: "errortext(rc)" Line "SIGL)
  369. end
  370.